Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/MyOOAbout.p

Text File | 1995-10-25 | 4.2 KB | 206 lines | [TEXT/CWIE]

unit MyOOAbout;

interface

    uses
        MyOOMainLoop;

    const
        agwtAbout = '•About';
        about_dialog_ID = 128;

    type
        AboutObject = object(DObject)
                procedure Create (id: integer);
                override;
                procedure DoItem (item: integer);
                override;
                function GetString (index: integer): str255;
            end;

    var
        about_click_count: longInt;

    procedure StartupAbout;
    procedure ConfigureAbout (obj: AboutObject);
    procedure UpdateAboutBox;
    procedure OpenAboutBox;
    procedure CloseAboutBox;

implementation

    uses
        Memory, Fonts, TextEdit, Resources, Icons,
        MyMenus, MyDialogs, MyStrings, MyVersionResource, MySystemGlobals, MyWindows, MyAssertions,
        MyFMenus, AERegistry, MyAEUtils, AEObjects, MyStrh, MyUtils, MyTypes, MyStartup, MyOOMenus,
        BaseGlobals;

    const
        about_strh_id = 928;

    var
        about_object: AboutObject;
        gAboutDisplayStyledStringProc : UniversalProcPtr;

    procedure AboutObject.DoItem (item: integer);
        var
            r: rect;
    begin
        about_click_count := about_click_count + 1;
        GetDItemRect(window, item, r);
        SetPort(window);
        InvalRect(r);
    end;

    function AboutObject.GetString (index: integer): str255;
        var
            vers: versionRecord;
    begin
        GetVersion(vers);
        case index of
            0:
                GetString := vers.longVersion;
            1:
                GetString := vers.shortVersion;
            2:
                GetString := vers.name;
            otherwise
                GetString := '???';
        end;
    end;

    procedure AboutDisplayStyledString (dlg: dialogPtr; item: integer);
        var
            s, t: str255;
            i, n: integer;
    begin
        GetIndString(s, about_strh_id, item);
        i := 1;
        while (i < length(s)) do begin
            if s[i] = '^' then begin
                n := ord(s[i+1])-48;
                if n>= 10 then begin
                    n := n-7;
                end;
                t := about_object.GetString(n);
                Delete(s, i, 2);
                Insert(t, s, i);
                i := i + length(t);
            end
            else begin
                i := i + 1;
            end;
        end;
        DisplayStyledString(dlg, item, s);
    end;

    procedure AboutObject.Create (id: integer);
        var
            s: str255;
            vers: versionRecord;
            i:integer;
    begin
        UseResFile(app_resfile);
        inherited Create(id);
        SetPort(window);
        close_hides_window := true;
        AppleGuideWindowType := agwtAbout;
        about_click_count := 0;
        gAboutDisplayStyledStringProc := NewUserItemProc(@AboutDisplayStyledString);
        SetMyFont(MFT_Geneva12);
        GetWTitle(window, s);
        GetVersion(vers);
        SPrintS3(s, s, vers.name, '', '');
        SetWTitle(window, s);
        for i := 1 to 30 do begin
            if GetIndStr(about_strh_id, i) <> '' then begin
                SetDItemHandle(window, i, gAboutDisplayStyledStringProc);
            end;
        end;
    end;

    procedure DoAbout;
    begin
        about_click_count := about_click_count + 1;
        if GetWindowVisible(about_object.window) then begin
            if FrontWindow <> about_object.window then begin
                SelectWindow(about_object.window);
            end;
        end else begin
            SelectWindow(about_object.window);
            ShowWindow(about_object.window);
        end;
    end;

    procedure DoAboutMenu;
    begin
        if has_AppleEvents then begin
            SendSelfSimpleEvent(kAECoreSuite, kAEAbout);
        end
        else begin
            DoAbout;
        end;
    end;

    procedure SetAboutMenu (themenu, theitem: integer);
    begin
        SetIDItemEnable(themenu, theitem, not ISWObjectFront(about_object));
    end;

    function HandleAbout (var event, reply: AppleEvent; refcon: longInt): OSErr;
    begin
        event:=event; { UNUSED! }
        reply:=reply; { UNUSED! }
        refcon:=refcon; { UNUSED! }
        DoAbout;
        HandleAbout := noErr;
    end;

    procedure UpdateAboutBox;
    begin
        SetPort(about_object.window);
        InvalRect(about_object.window^.portRect);
    end;

    procedure CloseAboutBox;
    begin
        about_object.DoClose;
    end;

    procedure OpenAboutBox;
    begin
        DoAbout;
        SetPort(about_object.window);
        DrawDialog(about_object.window);
        ValidRect(about_object.window^.portRect);
    end;

    function InitAbout(var msg: integer): OSStatus;
        var
            junk: OSErr;
    begin
        msg := msg; { Unused }
        if has_AppleEvents then begin
            junk := AEInstallEventHandler(kAECoreSuite, kAEAbout, NewAEEventHandlerProc(@HandleAbout), 0, false);
        end;
        SetFBoth(Cabout, DoAboutMenu, SetAboutMenu);
        InitAbout := noErr;
    end;

    procedure ConfigureAbout (obj: AboutObject);
    begin
        Assert(obj <> nil);
        about_object := obj;
    end;

    procedure StartupAbout;
    begin
        StartupDialogs;
        StartupFMenus;
        StartupMainLoop;
        StartupOOMenus;
        SetStartup(InitAbout, nil, 0, nil);
    end;

end.